Developer CD Series 1994 August: Tool Chest/Dev.CD Aug 94.toast/Tool Chest/Networking & Communications/MacTCP/MacTCP Developer Tools/HyperCard MacTCP Toolkit 1.0/Source Code ƒ/orderMessages.p

Text File | 1993-06-15 | 11.3 KB | 379 lines | [TEXT/MPS ]

(*
    orderMessages(string,group,checkMsgs) -- View the string as a series of subject lines from mail messages,
        with the message number preceeding each line. Move the message numbers to the end of each line, surrounded
        by international quotes («...»). Sort the lines by message number and remove duplicates. If the second
        parameter is "true", group together lines which are the same, ignoring initial "Re: "s. Take the third
        parameter as a sparse list (a list of items, each of which is a number or an interval specified by two numbers,
        low and high); for each message number in the list, put a check-mark in front of the corresponding message
        line.

    Note: This XCMD was developed specifically for the HyperNetNews stack, and is probably not very useful with
        any other stack. It is not really intended to provide any generally useful functionality.

    To compile and link this file using Macintosh Programmers Workshop,

        pascal -w orderMessages.p
        link -m ENTRYPOINT -o HyperCommands -rt XFCN=7869 -sn Main=orderMessages ∂
            orderMessages.p.o "{Libraries}HyperXLib.o" "{MPW}"Libraries:interface.o "{MPW}"Libraries:PLibraries:PasLib.o

    © Copyright 1989 by Apple Computer, Inc.

    Initial coding 2/15/89 by Harry R. Chesley.
*)

{$R-}

{$S orderMessages }     { Segment name must be the same as the command name. }

unit DummyUnit;

interface

uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;

procedure EntryPoint(paramPtr: XCmdPtr);

implementation

const

RETURN = 13;                { ASCII for carriage return. }

procedure orderMessages(paramPtr: XCmdPtr); forward;

procedure EntryPoint(paramPtr: XCmdPtr);

    begin
        orderMessages(paramPtr);
    end;

procedure orderMessages(paramPtr: XCmdPtr);

    type

    lineRec =
        record
            numberStart: Ptr;        { Start of number text. }
            textStart: Ptr;                { Start of main subject line text. }
            compareStart: Ptr;        { Place to start comparing lines (after number and "re: "). }
            msgNumber: LongInt;    { The actual message number. }
            checkMark: boolean;        { True if we're to put a check-mark before the line on output. }
            indent: boolean;            { True if we're to indent the line on output. }
        end;

    lineRecArray = array [1..30000] of lineRec;

    lineRecPtr = ^lineRecArray;
    lineRecHand = ^lineRecPtr;

    nextElement = (endOfString, newItem, newWord);

    var str: Str255;
        newEntry: lineRec;                { The latest input. }
        groupMessages: boolean;        { True if we should group subjects together. }
        sourceHand: Handle;                { Handle to the original source text. }
        checkPtr: Ptr;                        { Pointer into checkMsgs parameter. }
        loCheck: LongInt;                    { Low number in range from checkMsgs item. }
        highCheck: LongInt;                { High number in checkMsgs item range. }
        resultHand: Handle;                { Handle to the result text. }
        resultSize: longInt;                { Size of the result. }
        linePtrs: lineRecHand;            { Handle to the line pointers. }
        lineCount: integer;                { Number of lines in the source. }
        tempLine: lineRec;
        p, p2: Ptr;
        i, j, k, delta: integer;
        dupEntry: boolean;

    procedure Fail(errMsg: Str255); { set theResult and quit }
        begin
            paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
            exit(orderMessages);
        end;

    procedure disposAndFail(errMsg: Str255);
        begin
            HUnlock(sourceHand);
            disposHandle(Handle(linePtrs));
            Fail(errMsg);
        end;

    procedure putByte(b: SignedByte);
        { Store a byte into the location pointed to by p and increment p. }

        begin
            p^ := b;
            p := Ptr(ord4(p)+1);
        end;

    function linesEqual(x,y: integer): boolean;
        { Compare two lines in the linePtrs array for equality. }

        var l1, l2: Str255;

        begin
            ZeroToPas(paramPtr,linePtrs^^[x].compareStart,l1);
            ZeroToPas(paramPtr,linePtrs^^[y].compareStart,l2);
            linesEqual := StringEqual(paramPtr,l1,l2);
        end;

    function nextCheckItem: boolean;

        function nextCheckNum: LongInt;

            var theResult: LongInt;

            begin
                theResult := 0;
                while (checkPtr^ >= SignedByte('0')) and (checkPtr^ <= SignedByte('9')) do
                    begin
                        theResult := 10*theResult + checkPtr^ - signedByte('0');
                        checkPtr := Ptr(ord4(checkPtr)+1);
                    end;
                nextCheckNum := theResult;
            end;

        function nextCheckElement: nextElement;

            begin
                nextCheckElement := newWord;
                while (checkPtr^ <> 0) and ((checkPtr^ < SignedByte('0')) or (checkPtr^ > SignedByte('9'))) do
                    begin
                        if checkPtr^ = SignedByte(',') then nextCheckElement := newItem;
                        checkPtr := Ptr(ord4(checkPtr)+1);
                    end;
                if checkPtr^ = 0 then nextCheckElement := endOfString;
            end;

        begin
            if nextCheckElement = endOfString then nextCheckItem := false
            else
                begin
                    nextCheckItem := true;
                    loCheck := nextCheckNum;
                    if nextCheckElement = newWord then
                        begin
                            highCheck := nextCheckNum;
                            if not (nextCheckElement in [endOfString,newItem]) then disposAndFail('§§§ bad sparse array §§§');
                        end
                    else highCheck := loCheck;
                end;
        end;

    begin
        if paramPtr^.paramCount <> 3 then Fail('§§§ parameter count is not 3 §§§');

        sourceHand := paramPtr^.params[1];                        { First parameter is the string to be grouped. }
        ZeroToPas(paramPtr,paramPtr^.params[2]^,str);        { Second parameter is whether to group. }
        groupMessages := StringEqual(paramPtr,str,'true');

        { If there's anything in the string, process it. }
        if sourceHand <> NIL then
            begin

                { Create the line pointer array. }
                linePtrs := lineRecHand(NewHandle(0));
                if MemError <> noErr then Fail('§§§ NewHandle failed §§§');
                { Lock the source. }
                HLock(sourceHand);
                p := sourceHand^;
                { Find all the lines. }
                lineCount := 0;
                while p^ <> 0 do
                    begin
                        if lineCount >= 30000 then disposAndFail('§§§ too many lines §§§');
                        { Fill it in. }
                        with newEntry do
                            begin
                                { Find the message number. }
                                numberStart := p;
                                while (p^ >= SignedByte('0')) and (p^ <= SignedByte('9')) do p := Ptr(ord4(p)+1);
                                if p^ = SignedByte(' ') then
                                    begin
                                        p^ := 0;
                                        p := Ptr(ord4(p)+1);
                                        while p^ = SignedByte(' ') do p := Ptr(ord4(p)+1);
                                    end;
                                ZeroToPas(paramPtr,numberStart,str);
                                msgNumber := StrToNum(paramPtr,str);
                                { Find the text. }
                                textStart := p;
                                { Find the part of the text to compare (skip "re: " if it's there). }
                                compareStart := p;
                                checkMark := false;
                                indent := false;
                                if (p^ = SignedByte('R')) or (p^ = SignedByte('r')) then
                                    begin
                                        p := Ptr(ord4(p)+1);
                                        if (p^ = SignedByte('E')) or (p^ = SignedByte('e')) then
                                            begin
                                                p := Ptr(ord4(p)+1);
                                                if p^ = SignedByte(':') then
                                                    begin
                                                        p := Ptr(ord4(p)+1);
                                                        while p^ = SignedByte(' ') do p := Ptr(ord4(p)+1);
                                                        compareStart := p;
                                                    end;
                                            end;
                                    end;
                            end;
                        { Skip to the end of the line. }
                        while (p^ <> 0) and (p^ <> RETURN) do p := Ptr(ord4(p)+1);
                        if p^ <> 0 then
                            begin
                                p^ := 0;
                                p := Ptr(ord4(p)+1);
                            end;
                        { Find where it goes. }
                        i := 1;
                        dupEntry := false;
                        while i <= lineCount do
                            with linePtrs^^[i] do
                                if msgNumber = newEntry.msgNumber then
                                    begin
                                        dupEntry := true;
                                        leave;
                                    end
                                else if msgNumber > newEntry.msgNumber then leave
                                else i := i+1;
                        { If this is not a duplicate entry, insert it. }
                        { Note: Eliminating duplicates ensures we don't get snagged by an old NNTP server bug. }
                        if not dupEntry then
                            begin
                                { Allocate a line entry. }
                                lineCount := lineCount+1;
                                SetHandleSize(Handle(linePtrs),lineCount*sizeOf(lineRec));
                                if MemError <> noErr then disposAndFail('§§§ SetHandleSize failed §§§');
                                if i < lineCount then BlockMove(@linePtrs^^[i],@linePtrs^^[i+1],(lineCount-i)*sizeOf(lineRec));
                                linePtrs^^[i] := newEntry;
                            end;
                    end;

                { Go through the check messages list and check the messages. }
                checkPtr := paramPtr^.params[3]^;
                i := 1;
                while nextCheckItem and (i <= lineCount) do
                    begin
                        while i <= lineCount do
                            begin
                                if linePtrs^^[i].msgNumber >= loCheck then leave;
                                i := i+1;
                            end;
                        while i <= lineCount do
                            begin
                                if linePtrs^^[i].msgNumber <= highCheck then linePtrs^^[i].checkMark := true
                                else leave;
                                i := i+1;
                            end;
                    end;

                { Group the lines. }
                if groupMessages then
                    begin
                        { Cycle through them. }
                        i := 1;
                        while i < lineCount do
                            begin
                                { Cycle through all possible matches. }
                                delta := 1;
                                j := i+1;
                                while j <= lineCount do
                                    begin
                                        { Is this one groupable? }
                                        if linesEqual(i,j) then
                                            begin
                                                { If it is, shift up the other lines, and move that one into place. }
                                                linePtrs^^[j].indent := true;
                                                if j > (i+1) then
                                                    begin
                                                        tempLine := linePtrs^^[j];
                                                        for k := j downTo i+delta+1 do linePtrs^^[k] := linePtrs^^[k-1];
                                                        linePtrs^^[i+delta] := tempLine;
                                                    end;
                                                delta := delta+1;
                                            end;
                                        j := j+1;
                                    end;
                                i := i+delta;
                            end;
                    end;

                { Generate the output.}
                if lineCount > 0 then
                    begin
                        { First figure out how big the output is going to be. }
                        resultSize := 0;
                        for i := 1 to lineCount do
                            with linePtrs^^[i] do
                                begin
                                    if checkMark then resultSize := resultSize+1
                                    else resultSize := resultSize+3;
                                    if indent then resultSize := resultSize+2;
                                    p := numberStart;
                                    while p^ <> 0 do
                                        begin
                                            resultSize := resultSize+1;
                                            p := Ptr(ord4(p)+1);
                                        end;
                                    resultSize := resultSize+3;
                                    p := textStart;
                                    while p^ <> 0 do
                                        begin
                                            resultSize := resultSize+1;
                                            p := Ptr(ord4(p)+1);
                                        end;
                                    resultSize := resultSize+1;
                                end;
                        { Allocate the result handle. }
                        resultHand := NewHandle(resultSize);
                        if MemError <> noErr then disposAndFail('§§§ NewHandle failed §§§');
                        { Output the lines. }
                        p := resultHand^;
                        for i := 1 to lineCount do
                            with linePtrs^^[i] do
                                begin
                                    { Do the checkmark (if any). }
                                    if checkMark then putByte(SignedByte('√'))
                                    else
                                        begin
                                            putByte(SignedByte(' ')); putByte(SignedByte(' ')); putByte(SignedByte(' '));
                                        end;
                                    { Do the indentation (if any). }
                                    if indent then
                                        begin
                                            putByte(SignedByte('…')); putByte(SignedByte('…'));
                                        end;
                                    { Output the subject text. }
                                    p2 := textStart;
                                    while p2^ <> 0 do
                                        begin
                                            putByte(p2^);
                                            p2 := Ptr(ord4(p2)+1);
                                        end;
                                    { Append the message number. }
                                    putByte(SignedByte(' ')); putByte(SignedByte('«'));
                                    p2 := numberStart;
                                    while p2^ <> 0 do
                                        begin
                                            putByte(p2^);
                                            p2 := Ptr(ord4(p2)+1);
                                        end;
                                    putByte(SignedByte('»'));
                                    putByte(RETURN);
                                end;
                        { Zero terminate the result string. }
                        p := Ptr(ord4(p)-1);
                        p^ := 0;
                        { Unlock the source. }
                        HUnlock(sourceHand);
                        { Dispose the line pointer array. }
                        disposHandle(Handle(linePtrs));
                        { Return the handle. }
                        paramPtr^.returnValue := resultHand;
                    end
                else disposAndFail('');
            end
        else Fail('');
    end;

end.